COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(declare (fixsw t))
C00017 00003
C00020 ENDMK
C⊗;
(declare (fixsw t))
(declare (fasload meter fas dsk (tim lsp)))
(declare (setq meter:meterp ()))

(comment
(defun xreverse (current)
       (prog (next previous)
	     (m "Entries")
	     (m "PROGs")
	     b     
	     (mn "NULLs" null)
	     (cond ((null current)(return previous)))
	     (mn "CAR-CDRs" CDR)
	     (mn "SETQs" SETQ)
	     (setq next (cdr current))
	     (mn "RPLACs" rd)
	     (rplacd current previous)
	     (mn "NULLs" null)
	     (cond ((null next)(return current)))
	     (mn "CAR-CDRs" CDR)
	     (mn "SETQs" SETQ)
	     (setq previous (cdr next))
	     (mn "RPLCDs" rd)
	     (rplacd next current)
	     (mn "NULLs" null)
	     (cond ((null previous)(return next)))
	     (mn "CAR-CDRs" CDR)
	     (mn "SETQs" SETQ)
	     (setq current (cdr previous))
	     (mn "RPLCDs" rd)
	     (rplacd previous next)
	     (m "GOs")
	     (go b)))
)

(meter
(defun xreverse (current)
       (prog (next previous)
	     (m "Entries")
	     (m "PROGs")
	     (mn "NULLs" null)
	     (cond ((null current) (return ())))
	     b     
	     (mn "CAR-CDRs" CDR)
	     (mn "SETQs" SETQ)
	     (setq next (cdr current))
	     (mn "RPLACs" rd)
	     (rplacd current previous)
	     (mn "NULLs" null)
	     (cond ((null next)(return current)))
	     (mn "CAR-CDRs" CDR)
	     (mn "SETQs" SETQ)
	     (setq previous (cdr next))
	     (mn "RPLCDs" rd)
	     (rplacd next current)
	     (mn "NULLs" null)
	     (cond ((null previous)(return next)))
	     (mn "CAR-CDRs" CDR)
	     (mn "SETQs" SETQ)
	     (setq current (cdr previous))
	     (mn "RPLCDs" rd)
	     (rplacd previous next)
	     c
	     (mn "NULLs" null)
	     (cond ((null current)(return previous)))
	     (mn "GOs" go)
	     (go b))))
)

(meter
(defun greverse (current)
       (m "Entries")
       (let (x y)
	    (cond ((or (mn "NULLs" NULL 1 (null current))
		       (mn "NULLs" NULL 1
			    (null 
			     (mn "SETQs" SETQ 1
				  (setq x 
					(mn "CAR-CDRs" CDR 1 (cdr current)))))))
		   current)
		  ((mn "NULLs" NULL 1
			(null 
			 (mn "SETQs" SETQ 1 
			      (setq y 
				    (mn "CAR-CDRs" CDR 1 (cdr x))))))
		   (mn "RPLACs" ra 2)
		   (mn "CAR-CDRs" CDR 2)
		   (rplaca current
			   (prog1 (car x)
				  (rplaca x
					  (car current))))
		   current)
		  ((mn "NULLs" NULL 1 
			(null 
			 (mn "CAR-CDRs" CDR 1 (cdr y))))
		   (mn "RPLACs" ra 2)
		   (mn "CAR-CDRs" CDR 2)
		   (rplaca current
			   (prog1 (car y)
				  (rplaca y
					  (car current))))
		    current)
		  (t (prog (next previous first second)
			   (m "PROGs")
			   (mn "SETQs" SETQ 5)
			   (mn "CAR-CDRs" CDR)
			   (setq first current second x)
			   (setq previous y next x)
			   (setq current (cdr previous))
			   b     
			   (mn "RPLACs" ra)
			   (rplacd previous next)
			   (mn "SETQs" SETQ)
			   (mn "CAR-CDRs" CDR)
			   (setq next (cdr current))
			   (mn "NULLs" null)
			   (cond ((null next)
				  (mn "RPLACs" ra 2)
				  (mn "CAR-CDRs" CDR 2)
				  (rplaca first
					  (prog1 (car current)
						 (rplaca current
							 (car first))))
				  (mn "RPLACs" ra 2)
				  (rplacd first previous)
				  (rplacd second current)
				  (return first)))
			   (mn "RPLACs" ra)
			   (rplacd current previous)
			   (mn "SETQs" SETQ)
			   (mn "CAR-CDRs" CDR)
			   (setq previous (cdr next))
			   (mn "NULLs" null)
			   (cond ((null previous)
				  (mn "RPLACs" ra 2)
				  (mn "CAR-CDRs" CDR 2)
				  (rplaca first
					  (prog1 (car next)
						 (rplaca next
							 (car first))))
				  (mn "RPLADs" ra 2)
				  (rplacd first current)
				  (rplacd second next)
				  (return first)))
			   (mn "RPLACs" ra)
			   (rplacd next current)
			   (mn "SETQs" SETQ)
			   (mn "CAR-CDRs" CDR)
			   (setq current (cdr previous))
			   (mn "NULLs" null)
			   (cond ((null current) 
				  (mn "RPLACs" ra 2)
				  (mn "CAR-CDRs" CDR 2)
				  (rplaca first
					  (prog1 (car previous)
						 (rplaca previous
							 (car first))))
				  (mn "RPLACs" ra 2)
				  (rplacd first next)
				  (rplacd second previous)
				  (return first)))
			   (m "GOs")
			   (go b))))))
)
(include "timer.lsp[tim,lsp]")

(defun ghack (n m)
       (do ((n n (1- n))
	    (a ()))
	   ((= n 0))
	   (do ((m m (1- m)))
	       ((= m 0))
	       (setq a (greverse a)))
	   (push n a)))

(defun xhack (n m)
       (do ((n n (1- n))
	    (a ()))
	   ((= n 0))
	   (do ((m m (1- m)))
	       ((= m 0))
	       (setq a (xreverse a)))
	   (push n a)))

(defun ghack1 (n m)
       (do ((n n (1- n))
	    (a '(0 1 2 3))) 
	   ((= n 0))
	   (do ((m m (1- m)))
	       ((= m 0))
	       (setq a (greverse a)))
	   (push n a)))

(defun xhack1 (n m)
       (do ((n n (1- n))
	    (a '(0 1 2 3))) 
	   ((= n 0))
	   (do ((m m (1- m)))
	       ((= m 0))
	       (setq a (xreverse a)))
	   (push n a)))

(defun nhack (n m)
       (do ((n n (1- n))
	    (a ()))
	   ((= n 0))
	   (do ((m m (1- m)))
	       ((= m 0))
	       (setq a (nreverse a)))
	   (push n a)))

(timer gtimits
       (ghack 20. 5000.))

(timer xtimits
       (xhack 20. 5000.))

(timer ntimits
       (nhack 20. 5000.))

(timer gtimitl
       (ghack 500. 100.))

(timer xtimitl
       (xhack 500. 100.))
       
(timer ntimitl
       (nhack 500. 100.))
       
(timer xtimitl1
       (xhack1 500. 100.))
       
(timer gtimitl1
       (ghack1 500. 100.))
       


(comment
(defun greverse (current)
       (prog (next previous first second)
	     (cond ((null (setq first (cdr current)))
		    (return current))
		   ((null (setq second (cdr first)))
		    (rplaca current
			    (prog1 (car first)
				   (rplaca first 
					   (car current))))
		    (return current))
		   ((null (cdr second))
		    (rplaca current
			    (prog1 (car second)
				   (rplaca second
					   (car current))))
		    (return current)))
	     (setq first current second (cdr first))
	     b     
	     (cond ((null current) 
		    (rplaca first
			    (prog1 (car previous)
				   (rplaca previous
					   (car first))))
		    (rplacd first next)
		    (rplacd second previous)
		    (rplacd previous ())
		    (return first)))
	     (setq next (cdr current))
	     (rplacd current previous)
	     (cond ((null next)
		    (rplaca first
			    (prog1 (car current)
				   (rplaca current
					   (car first))))
		    (rplacd first previous)
		    (rplacd second current)
		    (rplacd current ())
		    (return first)))
	     (setq previous (cdr next))
	     (rplacd next current)
	     (cond ((null previous)
		    (rplaca first
			    (prog1 (car next)
				   (rplaca next
					   (car first))))
		    (rplacd first current)
		    (rplacd second next)
		    (rplacd next ())
		    (return first)))
	     (setq current (cdr previous))
	     (rplacd previous next)
	     (go b)))
)